Bilan analyse textuel - LDA - Projet PAT
Erwan Gouhier, Anna Mathieu
2026-01-08
1 Objectifs :
- Nous essayons de déterminer le nombre optimal de topic à retenir, k, notre principal hyperparamètre.
- Nous essayons d’obtenir des formes fortes de notre topic modelling pour consolider nos topics à travers les termes qui les caractérisent
Nous avions des soucis avec la LDA la semaine dernière liés à la reproductibilité (seed non fixés) et liés aux métriques d’évaluation des topics. La fonction utilisée ne permettait pas de récupérer plus que les coefficients beta (et les mots ayant le coeff beta le plus élevé pour chaque topic).
La fonction stm permet de fixer une seed et de récupérer plus de métriques, comme nous allons le développer plus tard.
La préparation des données est légèrement différentes, il faut préparer le vocabulaire (ensemble de tous les mots) ainsi que les documents (noms des documents => n° des PAT).
2 Préparation
# Préparation des documents
# Importation de res lemmat (voir Rapport du 04-12-25)
load("data/res.lemmat.RData")
# step 1 : Create the Vocabulary
vocab <- unique(res.lemmat$lem.f) # => liste unique de mots
head(vocab)## [1] "portrait" "situer" "croiser" "région" "département"
## [6] "confluence"# step 2 : Create a Word-to-Index Mapping
# on va associer les numéros des mots dans le vocabulaire (chaque mot prend un numero)
word_to_idx <- setNames(seq_along(vocab), vocab)
head(word_to_idx)## portrait situer croiser région département confluence
## 1 2 3 4 5 6# Step 3: Count Word Occurrences per Document
# Group by document and count occurrences of each word
doc_word_counts <- res.lemmat %>%
group_by(doc, lem.f) %>%
summarise(count = n(), .groups = 'drop')
# we count the frequency of each word in each document
head(doc_word_counts)# step4 4 : create document list
# Get unique documents in order => liste des documents
unique_docs <- unique(res.lemmat$doc)
head(unique_docs) # correspondent aux lignes de la BDD qui ont une description (ex : la n°3 n'en a pas)## [1] "text1" "text2" "text4" "text5" "text6" "text8"# Create the documents list
documents <- lapply(unique_docs, function(current_doc) {
# Filter words for this document
words_in_doc <- doc_word_counts %>%
filter(doc == current_doc)
# Convert words to indices
indices <- as.integer(word_to_idx[words_in_doc$lem.f])
counts <- as.integer(words_in_doc$count)
# Create 2-row matrix: row 1 = indices, row 2 = counts
matrix(c(indices, counts), nrow = 2, byrow = TRUE)
})
# on va créer une liste qui contient autant d'éléménts qu'il n'y a de textes, dans chaque élément, il y a les identifiants des mots qui sont cités dans le vocabulaire (le n° du mot ) et sa fréquence d'apparition dans ce texte
# Name the documents (optional but recommended)
names(documents) <- unique_docs
documents[[1]][1,1] # le premier mot du text 1 (par ordre alphabetique) est le numéro 135## [1] 135## [1] "accessible"## [1] 1# Step 5 : prep with prep documents
out <- prepDocuments(documents, vocab,
lower.thresh = 1, # remove words appearing in only 1 doc
upper.thresh = Inf)## Removing 1626 of 4334 terms (1626 of 41278 tokens) due to frequency
## Your corpus now has 349 documents, 2708 terms and 39652 tokens.3 Modèle et métriques
On va ensuite créer une fonction qui créé le modèle de topic modelling avec la fonction stm.
lda.model <- function(k, seed) {
topic_model<-stm(documents,
vocab,
K=k, verbose=FALSE, init.type = "LDA",
seed = seed)
return(topic_model)
}Exemple de fonctionnement de la fonction et des sorties :
Une première méthode à laquelle nous avons pensé consistait à afficher un graphique à la manière des valeurs propres en ACP pour décider du nombre de topics que l’on choisit pour notre LDA. On a créé une fonction qui prend en compte 2 arguments (nstart et nend), qui correspondent aux valeurs minimum et maximum du nombre de topics qu’on fixe dans notre LDA, la fonction teste pour toutes les valeurs de k comprises dans cet intervalle.
#On charge le simple triplet matrix que nous avions fait dans le rapport du 04-12
stm <- load(file="data/stm.RData")Pour ce qui est de la cohérence mesurée dans les topics avec la
fonction topic_coherence, elle mesure à quel point les
termes d’un même topic apparaissent ensemble.
Pour ce qui est du calcul, pour chaque mot d’un topic, on va calculer
un rapport entre :
- le nombre de co-occurrences de deux termes dans tous les
documents
- le nombre d’occurrences d’un des termes
Le calcul final pour obtenir la cohérence est le suivant :
\[ \text{UMass-Coherence} = \sum_{m=2}^{M} \sum_{l=1}^{m-1} \log \left( \frac{\text{df}_{m,l} + 1}{\text{df}_{l,l}} \right) \]
On fait la somme des logs de fréquences de co-occurrences pour chaque
terme d’un topic. Les éléments du calcul sont les suivants :
- df[m,l] : nombre de documents où les mots \(l\) et \(m\) d’un thème apparaissent ensemble ,on
ajoute +1 pour éviter un log de 0
df[l,l]: nombre de documents contenant le terme \(l\), auquel
Pour l’algorithme en lui-même, si l’on prend une matrice carrée de dimensions \(M \times M\), le calcul se fait sur la partie triangulaire inférieure de la matrice.
Pour donner une définition plus générale d’un score de cohérence :
“In general, a coherence score quantifies the degree of semantic interconnection among words within a given topic.”
— Farea et al., 2024
# install.packages("topicdoc")
library(topicdoc)
library(tidyverse)
load(file = 'data/stm.RData')
#Fonction visant à produir un graph montrant la cohérence moyenne des topicss proposé à la sortie d'une LDA entre 2 valeurs du nombre de topics
# nstart : nombre de topics minimum
# nend : nombre de topics maximum
# La fonction a un pas de 1 pour les valeurs de k, il est donc recommandé de ne pas mettre des valeurs trop éloignées
coherence_graph <- function(nstart,nend){
L <- as.data.frame(matrix(nrow=nend-nstart+1,ncol=2))
colnames(L) <- c("k","min_coherence")
L$k <- nstart:nend
for (k_topic in nstart:nend){
lda_model <- LDA(stm, k = k_topic, method = "Gibbs",
control = list(seed = as.integer(800)))
L$min_coherence[k_topic-nstart+1] <- min(topic_coherence(lda_model,stm))
}
return(L)
}
coherence <- coherence_graph(2,5)
coherence %>% ggplot(aes(x=k,y=min_coherence)) +
geom_line() +
geom_point() +
ggtitle("Cohérence moyenne des topics en fonction du nombre de topics")On récupère les 7 mots qui ont les scores les plus élevés par TOPIC pour les métriques suivantes : - coefficients beta : rappel => probabilité d’appartenance d’un terme dans un topic
- FREX : indice de fréquence exclusivité => moyenne harmonique pondérée dans laquelle le rang du mot est une combinaison de sa fréquence et de son exclusivité. La formule est :
\[\text{FREX}_{f,k} = \left( \frac{w}{\text{ECDF}_{\varphi,k}(\varphi_{f,k})} + \frac{1-w}{\text{ECDF}_{\mu,k}(\mu_{f,k})} \right)^{-1}\]
avec :
- k : le topic
- w : paramètre de poids (% associé à l’exclusivité et 1-w = % associé à la fréquence), par défaut w= 0.5
- la puissance -1 est une moyenne harmonique prenant en compte les deux termes suivants :
terme 1 - ECDF = fonction de répartition empirique cumulative des fréquences des mots d’un thème - \(\varphi_{f,k}\) = fréquence du mot f dans le topic k
terme 2 : - \(\mu_{f,k}\) : exclusivité d’un mot f dans un topic k - fonction de répartition empirique cumulative des exclusivité dans le topic k
Cet indice met l’accent sur des mots typiques et plus exclusifs des thèmes. La fréquence de certains termes très génériques présents dans le corpus et qui se retrouvent dans de nombreux thèmes (alimentaire, alimentation, territoire). Les mots avec le score le plus élevé sont ceux qui sont à la fois assez fréquents et à la fois assez exclusifs à un thème Bischof et al, 2012
On va ensuite créer une fonction qui va récupérer les mots qui caractérisent le plus nos topics extraits.
=> il faut donc choisir les métriques qui nous intéressent :
topic.extraction <- function(topic_model) {
# récupérer les mots avec les indices FREX (Fréquence exclusivité) les plus forts
frex <- data.frame(t(summary(topic_model)$frex))
# beta <- data.frame(t(summary(topic_model)$prob)) # et les scores beta les plus élevés
# créer liste_mots
# liste_mots <- rbind(frex,beta)
colnames(frex) <- paste0("topic",seq(from=1,to=9))
list <- sapply(frex, paste, collapse = " ")
list <- str_split(list, pattern = " ")
return (list)
}Extraction des termes de chaque thème avec Beta et frex et montrer que frex est plus discriminant :
# On utilise NaileR pour faire une extraction automatique de nos variables latentes
# avec FREX
# dataframe frex
frex.df <- data.frame(topic.extraction(modeltest))
colnames(frex.df) <- paste0(seq(from=1,to=9))
frex.df.pivot <- pivot_longer(data = frex.df, names_to = "topic", values_to = "word", cols = 1:9)
cat(gemini_generate(nail_textual(dataset = frex.df.pivot, num.var = 1, num.text = 2,
introduction = "A study on Territorial food systems is done and we want to find the topics discussed in the description of each Territorial food system, we use topic modelling and latent dirichlet allocation. Voici les mots qui ont les indices frex (fréquence exclusivité) les plus élevés pour chaque topic.",
request = "We want to automatically put a name on those topics based on the words caracterising them. Please give a name to each topic suming up most of the words caracterising it. Do it in French. Only give la Liste des Noms de Groupe Attribués",,
isolate.groups = F, drop.negative = T, generate = F)
)
)Avec uniquement les scores beta :
# avec scores BETA
beta.df <- data.frame(t(summary(modeltest)$prob))
colnames(beta.df) <- paste0(seq(from=1,to=9))
beta.df.pivot <- pivot_longer(data = beta.df, names_to = "topic", values_to = "word", cols = 1:9)
cat(gemini_generate(nail_textual(dataset = beta.df.pivot, num.var = 1, num.text = 2,
introduction = "A study on Territorial food systems is done and we want to find the topics discussed in the description of each Territorial food system, we use topic modelling and latent dirichlet allocation. Voici les mots qui ont les indices beta (probabilité d'appartenance du mot dans le topic) les plus élevés pour chaque topic.",
request = "We want to automatically put a name on those topics based on the words caracterising them. Please give a name to each topic suming up most of the words caracterising it. Do it in French. Only give la Liste des Noms de Groupe Attribués",,
isolate.groups = F, drop.negative = T, generate = F)
)
)Avec beta et frex :
# avec les deux
# betafrex <- data.frame(rbind(frex.df.pivot, beta.df.pivot))
#
# res.both <- (gemini_generate(nail_textual(dataset = betafrex, num.var = 1, num.text = 2,
#
# introduction = "A study on Territorial food systems is done and we want to find the topics discussed in the description of each Territorial food system, we use topic modelling and latent dirichlet allocation. Tu as les 7 mots qui ont les indices beta (probabilité d'appartenance du mot dans le topic) les plus élevés pour chaque topic., et les 7 mots qui ont les indices frex (fréquence exclusivité) les plus élevés pour chaque topic.",
# request = "We want to automatically put a name on those topics based on the words caracterising them. Please give a name to each topic suming up most of the words caracterising it. Do it in French. Only give la Liste des Noms de Groupe Attribués. Prends en compte les deux indicateurs mais ne sur-interprète pas les thèmes, tous les mots de doivent pas obligatoirement être utilisés. ",,
# isolate.groups = F, drop.negative = T, generate = F)
# )
# )
#
# cat(res.both)Comme nous l’avons développé, certains termes sont trop fréquents dans tous les topics et ‘polluent’ donc l’analyse textuelle et l’identification des nos thèmes.
*Thèmes Communs et Transversaux : Agriculture et
Alimentation : Presque tous les topics (1,
2, 3, 4, 5,
6, 7, 8, 9) incluent
des termes tels que “agricole”, “agriculture”, “alimentaire” ou
“alimentation”, confirmant que le cœur de l’étude concerne la production
et la consommation de nourriture. * Local et Territorial :** La
forte présence des mots “local” et “territorial” (1,
2, 3, 5, 6,
7, 8, 9) souligne l’ancrage
géographique et l’échelle d’analyse de ces systèmes.
4 Méthodologie
On va ensuite essayer de créer des “formes fortes” , en réalisant de nombreuses fois la LDA, puis en supprimant les mots les moins fréquents (n’apparaissant par exemple que dans un seul topic d’une seule LDA), et en regardant comment les mêmes mots s’associent de la même façon ensemble avec plusieurs itérations de l’algorithme. Les mots ne sont pas mis dans le même topic à chaque LDA, donc le ‘topic 1’ de la ‘lda1’ n’est pas le même que le ‘topic1’ de la ‘lda2’ mais s’il y a une stabilité dans les thèmes alors les mêmes mots se retrouveront dans les mêmes topics, et l’on s’intéresse justement aux termes qui composent ces topics (= la variable latente à nommer) plutôt qu’aux topics (1, 2, … etc) en eux-mêmes.
Nous avons testé plusieurs K, (9, 10, 15) et nous avons décidé de conserver k = 9 (augmenter le nombre de topics a eut pour effet que les mots associés dans les topics n’est pas forcément de sens ensemble donc la construction de l’espace latent des topics et la classification étaient peu satisfaisantes).
Nous avons essayé de réaliser la procédure en gardant les termes ayant les frex et les scores beta les plus élevés, et après avoir testé avec uniquement les scores frex, les groupes sont beaucoup plus discriminés donc nous avons décidé de ne conserver que cet indicateur permettant de construire des topics avec des termes suffisamment exclusifs de chaque topic.
Nous avons aussi essayé de conserver tous les mots dans l’espace latent final, cependant appliquer un filtre de fréquence (si un terme n’apparait qu’un nombre x minimal de fois dans l’ensemble des exécutions de l’algorithme) permet de réduire le nombre de points et de conserver des mots qui se retrouvent dans au moins plusieurs lda.
Nous réalisons n = 10 LDA que nous lançons à partir d’une seed aléatoire (que ici nous fixerons pour que les résultats soient exactement identiques).
5 Réalisation
5.1 Initialisation aléatoire et hyperparamètres
5.2 Création des modèles
# model1 <- lda.model(k = k, seed = seeds[1])
# model2 <- lda.model(k = k, seed = seeds[2])
# model3 <- lda.model(k = k, seed = seeds[3])
# model4 <- lda.model(k = k, seed = seeds[4])
# model5 <- lda.model(k = k, seed = seeds[5])
# model6 <- lda.model(k = k, seed = seeds[6])
# model7 <- lda.model(k = k, seed = seeds[7])
# model8 <- lda.model(k = k, seed = seeds[8])
# model9 <- lda.model(k = k, seed = seeds[9])
# model10 <- lda.model(k = k, seed = seeds[10])
# save(model1,model2,model3,model4,model5,model6,model7,model8,model9,model10, file = "data/modeles.RData")
load("data/modeles.RData")5.3 Extraction des termes
## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## A topic model with 9 topics, 349 documents and a 2708 word dictionary.## [[1]]
## [1] "sensibilisation" "gaspillage" "restauration" "tous"
## [5] "valoriser" "collectif" "sensibiliser"
##
## [[2]]
## [1] "régional" "pauvreté" "taux" "indicateur" "dominant"
## [6] "supérieur" "pôle"
##
## [[3]]
## [1] "changement" "préservation" "eau" "assurer"
## [5] "climatique" "biodiversité" "relocalisation"
##
## [[4]]
## [1] "sau" "prairie" "an" "cheptel" "national"
## [6] "exploitation" "augmentation"
##
## [[5]]
## [1] "schéma" "action" "plan" "engager" "contrat"
## [6] "programme" "élaboration"
##
## [[6]]
## [1] "manquer" "fruit" "légume"
## [4] "demander" "achat" "commercialisation"
## [7] "offrir"# rm(model1)
# rm(model2)
# rm(model3)
# rm(model4)
# rm(model5)
# rm(model6)
# rm(model7)
# rm(model8)
# rm(model9)
# rm(model10)on va ensuite mettre tous les mots ensemble :
lda_list <- list(words1,words2,words3,words4,words5,words6,words7,words8,words9,words10)
# on créé la liste avec les mots de chaque lda : n objets, contenant chacun k éléments (9 ici)
words <- unique(unlist(lda_list))# récupére la liste unique des mots de toutes les lda
# ajouter toutes les listes de mots
rm(words1)
rm(words2)
rm(words3)
rm(words4)
rm(words5)
rm(words6)
rm(words7)
rm(words8)
rm(words9)
rm(words10)
save(lda_list, file = "data/lda_list.RData")et on créé un tableau de données contenant en ligne les mots, en colonne chaque topic de chaque lda, et au croisement un “1” si le mot se retrouve dans les termes sélectionnés caractérisant ce topic, et sinon un “0”.
# Créer le data frame
col = paste0("lda", rep(1:nb_lda, each = k), "_topic", rep(1:k, times = nb_lda))
# on crée un vecteur avec les noms de colonnes avec x lda et n topics, et on le met dans l'ordre des lda
# c'est le vecteur des noms de colonnes de notre df
mfa.df = data.frame(matrix(ncol = k *nb_lda, nrow = length(words), NA))
# on créé le df => 1 + k * n colonnes , on le remplit de NA
colnames(mfa.df) <- col
# on met les noms de colonnes issus du vecteur col
rownames(mfa.df) <- words
# on ajoute les mots dans la colonne wordsOn va ensuite remplir le df :
# On va ensuite associer à chaque lda les mots des différents topics
for (i in 1:nb_lda) {
for (j in 1:k) {
col_name <- paste0("lda", i, "_topic", j)
# récupération des mots du topic j de la lda i
words_in_topic <- lda_list[[i]][[j]]
# lda_list[[i]][[j]] retourne les mots du topic j de la lda i
# pour chaque mot du dataframe
mfa.df[[col_name]] <- ifelse(
rownames(mfa.df) %in% words_in_topic,
1, # si le mot est dans ce topic
0
)
}
}
head(mfa.df[,1:10])Et on impose un filtre qui va d’abord calculer la somme de chaque ligne = le nombre de 1 = le nombre d’occurence de chaque mot sur l’ensemble des lda dans l’ensemble des topics Si cette fréquence est de 1, alors le mot (la ligne) est supprimée. On récupère ensuite le df final.
mfa.df.filtre <- mfa.df
mfa.df.filtre$freq <- apply(mfa.df, 1, sum)
# avec freq >= 2
mfa.df.filtre <- subset(mfa.df.filtre, freq>=2)
mfa.df.final <- mfa.df.filtre[,-ncol(mfa.df.filtre)] # supprimer la colonne fréquence
summary(colSums(mfa.df.final)) # on vérifie le nombre min, max, médian, moyen de mots par thèmes pour voir l'impact du filtrage ## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 5.000 6.000 5.556 7.000 7.000## [1] 262 90## [1] 132 90On va ensuite comparer deux méthodes pour l’obtention des formes fortes : un AFM avec autant de groupes de variables que de nb.lda et pour chaque groupe autant de variables que de k, et une AFC avec une transformation des fréquences en modalités, et autant de variables de termes uniques dans le vocabulaire.
5.4 AFM
L’AFM est une analyse dimensionnelle qui permet d’imposer une structure sur les variables, ce qui est nécessaire ici car chaque topic n’a de sens qu’au sein d’une exécution de la LDA, et les mots peuvent être parfois partagés au sein d’une lda ou entre topics de plusieurs LDA.
res.mfa <- MFA(base = mfa.df.final,
group = rep(k,nb_lda),
type = rep("f",nb_lda),
name.group = paste0("lda",seq(1:nb_lda)),
graph = FALSE
)
# on affiche le scree plot pour choisir le nombre de composantes à conserver
barplot(res.mfa$eig[1:40,2])
# on retient 5 composantes
res.mfa <- MFA(base = mfa.df.final,
group = rep(k,nb_lda),
type = rep("f",nb_lda),
name.group = paste0("lda",seq(1:nb_lda)),
ncp = 5
# graph = F
)## Warning: ggrepel: 11 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
## Warning: ggrepel: 132 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
## Ignoring unknown labels:
## • colour : ""
## Warning: ggrepel: 107 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
## Ignoring unknown labels:
## • colour : ""
clusters_topics <- kmeans(x = coord_topics, centers = 6)
centers <- clusters_topics$centers
temp.df <- data.frame(cbind(coord_topics,clust = clusters_topics$cluster))
temp.df$clust <- as.factor(temp.df$clust)
save(res.mfa, file = "data/res.mfa.RData")
# On va renommer les noms des clusters de 1 à 6 avec le nom du clusters
# On va ensuite extraire quels topics de quels lda ont permis de construire ce cluster
temp.df <- temp.df %>%
mutate(clust = fct_recode(clust,
secteur_agri = "1",
territoires = "2",
environnement = "3",
economie_alimentaire= "4",
gouvernance = "5",
education = "6"
))
temp.df %>%
ggplot() +
aes(x= Dim.1, y = Dim.2, col = clust) +
geom_point() +
scale_color_manual(values = c("chartreuse2","saddlebrown","springgreen4", "gold1","royalblue","tomato2")) 
On va reprendre le dataframe avec les theta, on va tous les combiner avec l’ensemble des topics de l’ensemble des LDA. On va renommer les colonnes, le nom du topic de la lda
# theta_all contient 90 colonnes : 9 topics * 10 LDA
theta_all <- data.frame(cbind(model1$theta, model2$theta, model3$theta, model4$theta, model5$theta,
model6$theta, model7$theta, model8$theta, model9$theta , model10$theta))
rm(model1)
rm(model2)
rm(model3)
rm(model4)
rm(model5)
rm(model6)
rm(model7)
rm(model8)
rm(model9)
rm(model10)
colnames(theta_all) <- colnames(mfa.df.final)
theta_all <- round((theta_all*100),2)
head(theta_all)# on va renommer ensuite les colonnes avec le nom des clusters, et aggréger ensuite par cluster dans "theta_resume"
theta_resume <- theta_all
# on renomme les noms des colonnes de theta_resume
colnames(theta_resume) <- temp.df$clust # => correspondance entre le nom des clusters et chaque topic de chaque lda
head(theta_resume)# et on calcule les nouvelles fréquences sur les 6 thématiques fortifiées
theta_resume_unique <- as.data.frame(
t(rowsum(
t(theta_resume),
group = colnames(theta_resume)
)))
theta_resume_unique <- 100*theta_resume_unique / 1000 # on passe en %
# save(theta_resume_unique, file = "data/theta_resume_unique.RData")
head(theta_resume_unique)On réalise ensuite une classification hierarchique de nos individus (mots).
On regarde le nombre optimal de clusters, les mots qui les composent et on essaye d’optimiser ce nombre de clusters.
clust7<- HCPC(res = res.mfa, nb.clust = 7, graph = FALSE)
clust8<- HCPC(res = res.mfa, nb.clust = 8, graph = F)Quel nombre de cluster a le plus de sens ?
plot_clust <- function(res.hcpc){
clust <- data.frame(cbind(word = rownames(mfa.df.final),
clust = res.hcpc$data.clust$clust,
dim1 = res.mfa$ind$coord[,1],
dim2 = res.mfa$ind$coord[,2]))
str(clust)
clust$clust <- as.factor(clust$clust)
clust$word <- as.factor((clust$word))
clust$dim1 <- as.numeric(clust$dim1)
clust$dim2 <- as.numeric(clust$dim2)
plot <- plot_ly(
data = clust,
x = ~dim1,
y = ~dim2,
type = "scatter",
mode = "markers+text",
color = ~factor(clust),
text = ~word, # nom de ta colonne contenant les mots
textposition = "top center",
marker = list(size = 7),
hoverinfo = "text"
) %>%
layout(
title = "Projection des mots dans l'espace factoriel (Dim 1 & Dim 2)",
xaxis = list(
title = "Dimension 1", # supprime le titre
showticklabels = FALSE, # supprime les graduations
zeroline = FALSE
),
yaxis = list(
title = "Dimension 2",
showticklabels = FALSE,
zeroline = FALSE
),
legend = list(title = list(text = "Cluster"))
)
plot
}## 'data.frame': 132 obs. of 4 variables:
## $ word : chr "sensibilisation" "gaspillage" "restauration" "tous" ...
## $ clust: chr "2" "2" "2" "2" ...
## $ dim1 : chr "-1.50456210968962" "-1.51161504948919" "-1.26867266688417" "-1.45487051670144" ...
## $ dim2 : chr "1.60066077846271" "1.43067565275201" "1.7457460422316" "1.11447171153656" ...## 'data.frame': 132 obs. of 4 variables:
## $ word : chr "sensibilisation" "gaspillage" "restauration" "tous" ...
## $ clust: chr "2" "2" "2" "2" ...
## $ dim1 : chr "-1.50456210968962" "-1.51161504948919" "-1.26867266688417" "-1.45487051670144" ...
## $ dim2 : chr "1.60066077846271" "1.43067565275201" "1.7457460422316" "1.11447171153656" ...## 'data.frame': 132 obs. of 4 variables:
## $ word : chr "sensibilisation" "gaspillage" "restauration" "tous" ...
## $ clust: chr "2" "2" "2" "2" ...
## $ dim1 : chr "-1.50456210968962" "-1.51161504948919" "-1.26867266688417" "-1.45487051670144" ...
## $ dim2 : chr "1.60066077846271" "1.43067565275201" "1.7457460422316" "1.11447171153656" ...On choisit le nombre de clusters retenus :
et on extrait les coordonnées des individus et leur appartenance à un cluster :
# création du jdd contenant les mots, leurs coordonnées sur les dimensions 1 et 2 ainsi que leur topic
clust <- data.frame(cbind(word = rownames(mfa.df.final),
clust = res.hcpc$data.clust$clust,
dim1 = res.mfa$ind$coord[,1],
dim2 = res.mfa$ind$coord[,2]))
str(clust)## 'data.frame': 132 obs. of 4 variables:
## $ word : chr "sensibilisation" "gaspillage" "restauration" "tous" ...
## $ clust: chr "2" "2" "2" "2" ...
## $ dim1 : chr "-1.50456210968962" "-1.51161504948919" "-1.26867266688417" "-1.45487051670144" ...
## $ dim2 : chr "1.60066077846271" "1.43067565275201" "1.7457460422316" "1.11447171153656" ...clust$clust <- as.factor(clust$clust)
clust$word <- as.factor((clust$word))
clust$dim1 <- as.numeric(clust$dim1)
clust$dim2 <- as.numeric(clust$dim2)
head(clust)On récupère ensuite l’ensemble des mots de chaque clusters et on réalise l’extraction de la variable latente (nom du topic)
# récupération des mots de chaque clusters
# mots.clust <- tapply(
# clust$word, # Le vecteur à appliquer la fonction (les Mots)
# clust$clust, # Le facteur de regroupement (les Clusters)
# paste, # La fonction à appliquer
# collapse = ", ") # L
# interprétation avec naileR (à faire plus tard)
# cat(gemini_generate(nail_textual(dataset = clust[,1:2], num.var = 2, num.text = 1,
#
# introduction = "A study on Territorial food systems is done and we want to find the topics discussed in the description of each Territorial food system, we use topic modelling and latent dirichlet allocation. We consolidate our topics by using multiple executions of the algorithm and perform MFA to find strong forms in our topics.",
# request = "We want to automatically put a name on those topics based on the words caracterising them. Please give a name to each topic suming up most of the words caracterising it. Do it in French. Only give la Liste des Noms de Groupe Attribués",,
# isolate.groups = F, drop.negative = T, generate = F)
# )
# )
#
# #res
#
# descr.topic <- gemini_generate(res)
#
# cat(descr.topic)Comparison of All Groups
Les six groupes de mots, identifiés comme des thèmes distincts au sein des systèmes alimentaires territoriaux (SAT), révèlent des facettes complémentaires de ces dynamiques complexes:
Planification et Animation Territoriale (Groupe 1): Ce thème met l’accent sur les processus de gouvernance, de collaboration et de mise en œuvre stratégique des projets alimentaires territoriaux. Il souligne l’importance des partenariats, de l’engagement communautaire et des cadres d’action pour structurer le SAT.
Restauration Collective et Éducation Alimentaire (Groupe 2): Ce groupe se concentre sur les enjeux de la demande et de la consommation, en particulier au sein de la restauration collective (notamment scolaire). Il aborde les initiatives visant à promouvoir une alimentation saine, durable et locale, la lutte contre le gaspillage, et l’éducation des consommateurs, souvent en lien avec des politiques publiques comme EGalim.
Typologies Territoriales et Productions Spécifiques (Groupe 3): Ce thème décrit les caractéristiques géographiques, démographiques et productives des territoires. Il distingue différents types d’espaces (urbains, ruraux, montagneux, périurbains) et les productions agricoles ou transformées spécifiques qui y sont associées, offrant un aperçu du contexte intrinsèque de chaque SAT.
Enjeux Climatiques, Environnementaux et Santé (Groupe 4): Ce groupe met en lumière les défis majeurs auxquels les SAT sont confrontés. Il couvre les impacts du changement climatique (sécheresse, gestion de l’eau), la préservation de la biodiversité, ainsi que les questions de santé publique liées à l’alimentation (obésité, maladies), soulignant la nécessité d’adaptation et de résilience.
Analyse Socio-Économique et Agricole (Groupe 5): Ce thème est axé sur les indicateurs quantitatifs et les dynamiques économiques et sociales. Il analyse les données statistiques concernant la production agricole (cheptel, céréales, SAU), les conditions socio-économiques des ménages (pauvreté) et les tendances générales à différentes échelles territoriales.
Logistique et Commercialisation des Filières (Groupe 6): Ce groupe aborde les aspects pratiques de la chaîne d’approvisionnement et de la mise sur le marché des produits. Il traite des défis liés à la distribution, à la commercialisation, à la logistique et aux débouchés pour les producteurs, notamment pour les fruits et légumes, identifiant les freins et les leviers d’action.
En somme, ces thèmes dessinent un panorama holistique des systèmes alimentaires territoriaux, couvrant leur gouvernance, leurs interactions avec les consommateurs, leurs spécificités géographiques, leurs vulnérabilités environnementales, leurs fondements socio-économiques et leurs mécanismes de marché.
Liste des Noms de Groupe Attribués
- Groupe 1: Planification et Animation Territoriale
- Groupe 2: Restauration Collective et Éducation Alimentaire
- Groupe 3: Typologies Territoriales et Productions Spécifiques
- Groupe 4: Enjeux Climatiques, Environnementaux et Santé
- Groupe 5: Analyse Socio-Économique et Agricole
- Groupe 6: Logistique et Commercialisation des Filières
5.5 Test AFM quali
Nous avons aussi essayé une AFM avec comme classe de variable ‘n’ => catégorielle.
afm.quali <- data.frame(lapply(mfa.df.final, FUN = as.factor ))
rownames(afm.quali) <- rownames(mfa.df.final)
# str(head(afm.quali))
res.fma.q <- MFA(base = afm.quali,
group = rep(k,nb_lda),
type = rep("n",nb_lda),
name.group = paste0("lda",seq(1:nb_lda))
)Il semblerait difficile d’identifier des formes fortes car en utilisant un type catégorielle, les mots ‘…’ , … tirent fortement les axes donc cette méthode ne permet pas de consolider notre LDA.
5.6 AFC
afc.df <- data.frame(t(mfa.df.final))
# str(head(afc.df))
res.afc <- CA(afc.df)
barplot(res.afc$eig[,2]) # on retient 5 ncp
res.afc <- CA(afc.df, ncp = 5)
plot.CA(res.afc, invisible = "row")Si on fait une classification issue du résultat de l’AFC, il semblerait que les formes fortes observées soient les mêmes que dans la méthode 1.
6 Conclusion
Il semble intéressant d’utiliser des analyses factorielles pour consolider nos topic modellings et obtenir des formes fortes de nos topics. Après avoir lancé cet algorithme en faisant varier beaucoup les paramètres, on a pu observer une relative sensabilité à la modification de la stop_words liste des mots, ainsi évidemment qu’au paramètre k, ainsi que des topics très “forts” toujours retrouvés et composés des mêmes termes.
Le résultat présenté (6 clusters) nous semble cohérents au vue de tous les essais réalisés, rendant compte de thématiques qui portent du sens (bien que certaines soient composés de plusieurs sous-sujets), et que l’on a retrouvé systématiquement.